home *** CD-ROM | disk | FTP | other *** search
/ Aminet 12 / Aminet 12 (1996)(GTI - Schatztruhe)[!][Jun 1996].iso / Aminet / biz / dbase / Archie1_2.lha / Archie-Distribution / Archie / Archie.rexx < prev    next >
OS/2 REXX Batch file  |  1996-03-11  |  24KB  |  892 lines
  1. /*
  2. ** The famous ARCHIE Archiver (c) 1996 by Peter D. Habermehl
  3. ** $VER: Archie V1.2 11.03.96
  4. */
  5.  
  6. /*
  7. ** Init
  8. */
  9. pathum = PRAGMA("D")
  10. say pathum
  11. LoadLibrary('rexxsupport.library',)
  12. LoadLibrary('rexxreqtools.library')
  13.  
  14. OPTIONS RESULTS
  15.  
  16. datei = "Archivdatei"
  17. entries = 0
  18. info = "Infostring"
  19. rubriken = 0
  20.  
  21. load = FALSE
  22. save = TRUE
  23.  
  24. OpenVarexx=LoadVarexx()
  25. ADDRESS VAREXX
  26.  
  27. result = OpenPort("MYPORT")
  28.  
  29. ADDRESS VALUE OpenGUI("ArchieMain.GUI")
  30.  
  31. SetMainGUI()
  32.  
  33. /*
  34. ** Main Loop
  35. */
  36.  
  37. DO FOREVER
  38.   CALL WaitPKT('MYPORT')
  39.   pkt=GetPKT('MYPORT')
  40.   IF pkt ~= '00000000'x THEN DO
  41.     class=SUBWORD(GetArg(pkt),1,1)
  42.     SELECT
  43.       WHEN class = CloseWindow THEN LEAVE
  44.       WHEN class = 'QUIT' THEN LEAVE
  45.       WHEN class = 'WAHL' THEN Archiv()
  46.       WHEN class = 'INFO' THEN DO
  47.                                  info = SUBWORD(GetArg(pkt),2)
  48.                                  save = FALSE
  49.                                END
  50.       WHEN class = 'EINGEBEN' THEN Eingeben()
  51.       WHEN class = 'EDITIEREN' THEN Editieren()
  52.       WHEN class = 'SUCHEN' THEN Suchen()
  53.       WHEN class = 'SPEICHERN' THEN Speichern()
  54.     OTHERWISE
  55.     END
  56.     SetMainGui()
  57.   END
  58. END
  59.  
  60. IF save = FALSE THEN askforsave()
  61.  
  62. 'hide unload'
  63. CALL ClosePort("MYPORT")
  64.  
  65. /*
  66. ** Showdown
  67. */
  68.  
  69. IF OpenVarexx=1 THEN CloseVarexx
  70. EXIT
  71.  
  72. /*
  73. ** Subprograms
  74. */
  75.  
  76. Archiv:
  77.   IF save = FALSE THEN askforsave()
  78.  
  79.   new_file = rtfilerequest(,,"Lade Archiv","Laden","rtfi_flags=freqf_patgad rtfi_matchpat=#?.archie",nil)
  80.   IF new_file ~="" THEN DO
  81.     IF EXISTS(new_file) THEN DO
  82.       IF Open(file,new_file,"READ") THEN DO
  83.       test=READLN(file)
  84.       IF test="ARCHIE-ARCHIVDATEI" THEN DO
  85.         datei=new_file
  86.         info=READLN(file)
  87.         r="rubriken="||READLN(file)
  88.         INTERPRET r
  89.         DO i=1 TO rubriken
  90.           Rubrik.i=READLN(file)
  91.         END
  92.         r="entries="||READLN(file)
  93.         INTERPRET r
  94.         DO i=1 TO entries
  95.           ausgabe.i=READLN(file)
  96.           jahr.i=READLN(file)
  97.           seite.i=READLN(file)
  98.           rubrick.i=READLN(file)
  99.           eintrag.i=READLN(file)
  100.         END
  101.       END
  102.       else DO
  103.         bodytext = "Dies ist keine Archivdatei!"
  104.         tagstring = "rt_reqpos=reqpos.centerwin"
  105.         dummy = rtezrequest(bodytext,"Okay","Fehler:",,tagstring)
  106.       END
  107.       CALL Close(file)
  108.     END
  109.     save=TRUE
  110.     load=TRUE
  111.     END
  112.     else NeuAnlegen()
  113.   END
  114. RETURN 0
  115.  
  116. Eingeben:
  117.   'hide unload'
  118.   ADDRESS VAREXX
  119.   ADDRESS VALUE OpenGUI("ArchieEingabe.gui")
  120.  
  121.   Ausgabe = ""
  122.   Jahr = ""
  123.   Seite = ""
  124.   Rubrick = rubrik.1
  125.   Eintrag = ""
  126.   entries=entries+1
  127.  
  128.   SetText "AUSGABE" Ausgabe
  129.   SetText "JAHR" Jahr
  130.   SetText "EINTRAGNUMMER" entries
  131.   SetText "SEITE" Seite
  132.   SetText "RUBRIK" Rubrick
  133.   SetText "EINTRAG" Eintrag
  134.   rubrik.select = 1
  135.   rubrik.count=rubriken
  136.   SetList "RUBRIKEN" CLEAR STEM rubrik
  137.  
  138.   DO FOREVER
  139.     CALL WaitPKT('MYPORT')
  140.     pkt=GetPKT('MYPORT')
  141.     IF pkt ~= '00000000'x THEN DO
  142.       class=SUBWORD(GetArg(pkt),1,1)
  143.       SELECT
  144.       WHEN class = CloseWindow THEN LEAVE
  145.       WHEN class = "EINGABEENDE" THEN LEAVE
  146.       WHEN class = "AUSGABE" THEN Ausgabe = SUBWORD(GetArg(pkt),2)
  147.       WHEN class = "JAHR" THEN Jahr = SUBWORD(GetArg(pkt),2)
  148.       WHEN class = "SEITE" THEN Seite = SUBWORD(GetArg(pkt),2)
  149.       WHEN class = "EINTRAG" THEN Eintrag = SUBWORD(GetArg(pkt),2)
  150.       WHEN class = "RUBRIKEN" THEN DO
  151.         Rubrick = SUBWORD(GetArg(pkt),2)
  152.         SetText "RUBRIK" Rubrick
  153.       END
  154.       WHEN class = "OKAY" THEN DO
  155.         ausgabe.entries = Ausgabe
  156.         jahr.entries = Jahr
  157.         seite.entries = Seite
  158.         rubrick.entries = Rubrick
  159.         eintrag.entries = Eintrag
  160.         entries=entries+1
  161.         Seite = ""
  162.         Eintrag = ""
  163.         SetText "SEITE" Seite
  164.         SetText "EINTRAG" Eintrag
  165.         SetText "EINTRAGNUMMER" entries
  166.         save = FALSE
  167.       END
  168.       OTHERWISE
  169.       END
  170.     END
  171.   END
  172.   entries=entries-1
  173.  
  174.   'hide unload'
  175.   ADDRESS VAREXX
  176.   ADDRESS VALUE OpenGUI("ArchieMain.gui")
  177.  
  178. RETURN 0
  179.  
  180. Editieren:
  181.   'hide unload'
  182.   ADDRESS VAREXX
  183.   ADDRESS VALUE OpenGUI("ArchieEditieren.gui")
  184.  
  185.   current=entries
  186.  
  187.   Ausgabe = ausgabe.current
  188.   Jahr = jahr.current
  189.   Seite = seite.current
  190.   Rubrick = Rubrick.current
  191.   Eintrag = Eintrag.current
  192.  
  193.   SetText "AUSGABE" Ausgabe
  194.   SetText "JAHR" Jahr
  195.   SetText "SEITE" Seite
  196.   SetText "RUBRIK" Rubrick
  197.   SetText "EINTRAG" Eintrag
  198.   SetText "EINTRAGNUMMER" current
  199.   SetText "STATUS" "gesichert"
  200.  
  201.   DO i=1 TO rubriken
  202.    IF rubrik.i=Rubrick THEN rubrik.select = i
  203.   END
  204.   rubrik.count=rubriken
  205.   SetList "RUBRIKEN" CLEAR STEM rubrik
  206.   one=1
  207.   SetBar "SLIDER" VISIBLE 1 TOTAL entries
  208.   SetNum "SLIDER" current
  209.   csave = TRUE
  210.  
  211.   DO FOREVER
  212.     CALL WaitPKT('MYPORT')
  213.     pkt=GetPKT('MYPORT')
  214.     IF pkt ~= '00000000'x THEN DO
  215.       class=SUBWORD(GetArg(pkt),1,1)
  216.       SELECT
  217.       WHEN class = CloseWindow THEN LEAVE   
  218.       WHEN class = "ENDE" THEN LEAVE
  219.       WHEN class = "AUSGABE" THEN DO
  220.         Ausgabe = SUBWORD(GetArg(pkt),2)
  221.         csave=FALSE
  222.         END
  223.       WHEN class = "JAHR" THEN DO
  224.         Jahr = SUBWORD(GetArg(pkt),2)
  225.         csave=FALSE
  226.         END
  227.       WHEN class = "SEITE" THEN DO
  228.         Seite = SUBWORD(GetArg(pkt),2)
  229.         csave=FALSE
  230.         END
  231.       WHEN class = "EINTRAG" THEN DO
  232.         Eintrag = SUBWORD(GetArg(pkt),2)
  233.         csave=FALSE
  234.         END
  235.       WHEN class = "RUBRIKEN" THEN DO
  236.         Rubrick = SUBWORD(GetArg(pkt),2)
  237.         SetText "RUBRIK" Rubrick
  238.         csave=FALSE
  239.       END 
  240.       WHEN class = "SICHERN" THEN DO
  241.         ausgabe.current = Ausgabe
  242.         jahr.current = Jahr
  243.         seite.current = Seite
  244.         rubrick.current = Rubrick
  245.         eintrag.current = Eintrag
  246.         csave=TRUE
  247.         save=FALSE
  248.       END
  249.       WHEN class = "VERWERFEN" THEN DO
  250.         Ausgabe = ausgabe.current
  251.         Jahr = jahr.current
  252.         Seite = seite.current
  253.         Rubrick = Rubrick.current
  254.         Eintrag = Eintrag.current
  255.  
  256.         SetText "AUSGABE" Ausgabe
  257.         SetText "JAHR" Jahr
  258.         SetText "SEITE" Seite
  259.         SetText "RUBRIK" Rubrick
  260.         SetText "EINTRAG" Eintrag
  261.         SetText "EINTRAGNUMMER" current
  262.         csave=TRUE
  263.       END
  264.       WHEN class = "EINTRAGNUMMER" THEN DO
  265.         r = "zahl="||SUBWORD(GetArg(pkt),2)
  266.         INTERPRET r
  267.         zahl=TRUNC(zahl)
  268.         if (zahl<(entries+1))&(zahl>0) THEN current=zahl
  269.         Ausgabe = ausgabe.current
  270.         Jahr = jahr.current
  271.         Seite = seite.current
  272.         Rubrick = Rubrick.current
  273.         Eintrag = Eintrag.current
  274.  
  275.         SetText "AUSGABE" Ausgabe
  276.         SetText "JAHR" Jahr
  277.         SetText "SEITE" Seite
  278.         SetText "RUBRIK" Rubrick
  279.         SetText "EINTRAG" Eintrag
  280.         SetText "EINTRAGNUMMER" current
  281.         SetNum "SLIDER" current
  282.         csave=TRUE                      
  283.       END
  284.       WHEN class = "SLIDER" THEN DO
  285.         r = "zahl="||SUBWORD(GetArg(pkt),2)
  286.         INTERPRET r
  287.         zahl=TRUNC(zahl)
  288.         if (zahl<(entries+1))&(zahl>0) THEN current=zahl
  289.         Ausgabe = ausgabe.current
  290.         Jahr = jahr.current
  291.         Seite = seite.current
  292.         Rubrick = Rubrick.current
  293.         Eintrag = Eintrag.current
  294.  
  295.         SetText "AUSGABE" Ausgabe
  296.         SetText "JAHR" Jahr
  297.         SetText "SEITE" Seite
  298.         SetText "RUBRIK" Rubrick
  299.         SetText "EINTRAG" Eintrag
  300.         SetText "EINTRAGNUMMER" current
  301.         SetNum "NUMMER" current
  302.         csave=TRUE
  303.       END
  304.       WHEN class = "MINUS" THEN DO
  305.         zahl=current-1
  306.         if (zahl<(entries+1))&(zahl>0) THEN current=zahl
  307.         Ausgabe = ausgabe.current
  308.         Jahr = jahr.current
  309.         Seite = seite.current
  310.         Rubrick = Rubrick.current
  311.         Eintrag = Eintrag.current
  312.  
  313.         SetText "AUSGABE" Ausgabe
  314.         SetText "JAHR" Jahr
  315.         SetText "SEITE" Seite
  316.         SetText "RUBRIK" Rubrick
  317.         SetText "EINTRAG" Eintrag
  318.         SetText "EINTRAGNUMMER" current
  319.         SetNum "SLIDER" current
  320.         csave=TRUE 
  321.       END
  322.       WHEN class = "PLUS" THEN DO
  323.         zahl=current+1
  324.         if (zahl<(entries+1))&(zahl>0) THEN current=zahl
  325.         Ausgabe = ausgabe.current
  326.         Jahr = jahr.current
  327.         Seite = seite.current
  328.         Rubrick = Rubrick.current
  329.         Eintrag = Eintrag.current
  330.  
  331.         SetText "AUSGABE" Ausgabe
  332.         SetText "JAHR" Jahr
  333.         SetText "SEITE" Seite
  334.         SetText "RUBRIK" Rubrick
  335.         SetText "EINTRAG" Eintrag
  336.         SetText "EINTRAGNUMMER" current
  337.         SetNum "SLIDER" current
  338.         csave=TRUE 
  339.       END
  340.       WHEN class = "KILL" THEN DO
  341.         IF entries>1 THEN DO
  342.           DO i=current to entries-1
  343.             k=i+1
  344.             Ausgabe.i = ausgabe.k
  345.             Jahr.i = jahr.k
  346.             Seite.i = seite.k
  347.             Rubrick.i = Rubrick.k
  348.             Eintrag.i = Eintrag.k
  349.           END
  350.           IF current=entries THEN current=current-1
  351.           entries=entries-1
  352.           Ausgabe = ausgabe.current
  353.           Jahr = jahr.current
  354.           Seite = seite.current
  355.           Rubrick = Rubrick.current
  356.           Eintrag = Eintrag.current
  357.  
  358.           SetText "AUSGABE" Ausgabe
  359.           SetText "JAHR" Jahr
  360.           SetText "SEITE" Seite
  361.           SetText "RUBRIK" Rubrick
  362.           SetText "EINTRAG" Eintrag
  363.           SetText "EINTRAGNUMMER" current
  364.           SetBar "SLIDER" VISIBLE 1 TOTAL entries
  365.           SetNum "SLIDER" current
  366.           csave=TRUE
  367.           save=FALSE
  368.        END
  369.       END
  370.       OTHERWISE
  371.       END
  372.       IF csave=TRUE THEN SetText "STATUS" "gesichert"
  373.       else SetText "STATUS" "nicht gesichert"
  374.     END
  375.   END
  376.  
  377.   'hide unload'
  378.   ADDRESS VAREXX
  379.   ADDRESS VALUE OpenGUI("ArchieMain.gui")  
  380.  
  381. RETURN 0
  382.  
  383. Suchen:
  384.   'hide unload'
  385.   ADDRESS VAREXX
  386.   ADDRESS VALUE OpenGUI("ArchieSuchen.gui")
  387.  
  388.   rubriken=rubriken+1
  389.   rubrik.rubriken="<alle Rubriken>"
  390.   SetText "RUBRIK" rubrik.rubriken
  391.  
  392.   gefunden=0
  393.   gefpointer=0
  394.   gefstring = DecToStr(gefunden)
  395.   SetText "GEFUNDEN" gefstring
  396.  
  397.   such_ausgabe="*"
  398.   such_jahr="*"
  399.   such_nummer="*"
  400.   such_seite="*"
  401.   such_rubrik=rubrik.rubriken
  402.   such_eintrag="*"
  403.  
  404.   rubrik.count=rubriken
  405.   rubrik.select=such_rubrik
  406.   SetList "RUBRIKEN" CLEAR STEM rubrik
  407.  
  408.   druck=0
  409.   speichern=0    /* 0=alle , 1=diesen */
  410.   vergessen=0
  411.  
  412.   SetBar "GEFNUMMER" VISIBLE 1 TOTAL gefunden
  413.   SetNum "GEFNUMMER" gefpointer
  414.  
  415.   DO FOREVER
  416.     CALL WaitPKT('MYPORT')
  417.     pkt=GetPKT('MYPORT')
  418.     IF pkt ~= '00000000'x THEN DO
  419.       class=SUBWORD(GetArg(pkt),1,1)
  420.       SELECT
  421.       WHEN class = CloseWindow THEN LEAVE  
  422.       WHEN class = "ENDE" THEN LEAVE
  423.       WHEN class = "AUSGABE" THEN DO
  424.         such_ausgabe = SUBWORD(GetArg(pkt),2)
  425.         such_ausgabe = SuchString(such_ausgabe)
  426.         SetText "AUSGABE" such_ausgabe
  427.       END
  428.       WHEN class = "JAHR" THEN DO
  429.         such_JAHR=SUBWORD(GetArg(pkt),2)
  430.         such_JAHR=SuchString(such_jahr)
  431.         SetText "JAHR" such_jahr
  432.       END 
  433.       WHEN class = "NUMMER" THEN DO
  434.         such_nummer=SUBWORD(GetArg(pkt),2)
  435.         such_nummer=SuchString(such_nummer)
  436.         SetText "NUMMER" such_nummer
  437.       END 
  438.       WHEN class = "SEITE" THEN DO
  439.         such_seite=SUBWORD(GetArg(pkt),2)
  440.         such_seite=SuchString(such_seite)
  441.         SetText "SEITE" such_seite
  442.       END 
  443.       WHEN class = "EINTRAG" THEN DO
  444.         such_eintrag=SUBWORD(GetArg(pkt),2)
  445.         such_eintrag=SuchString(such_eintrag)
  446.         SetText "EINTRAG" such_eintrag
  447.       END 
  448.       WHEN class = "RUBRIKEN" THEN DO
  449.         such_rubrik = SUBWORD(GetArg(pkt),2)
  450.         SetText "RUBRIK" such_rubrik
  451.       END
  452.       WHEN class = "SUCHEN" THEN DO
  453.         'BUSY SET'
  454.         DO k=1 TO entries
  455.           stimmt=TRUE
  456.           s1=WildMatch(ausgabe.k,such_ausgabe)
  457.           s2=WildMatch(jahr.k,such_jahr)
  458.           s3=WildMatch(seite.k,such_seite)
  459.           s4=WildMatch(eintrag.k,such_eintrag)
  460.           IF such_rubrik = "<alle Rubriken>" THEN s5=TRUE
  461.           else DO
  462.             s5=FALSE
  463.             IF such_rubrik = rubrick.k THEN s5=TRUE
  464.           END
  465.           if (s1=TRUE)&(s2=TRUE)&(s3=TRUE)&(s4=TRUE)&(s5=TRUE) THEN DO
  466.             gefunden=gefunden+1
  467.             match_entry.gefunden=k
  468.           END
  469.         END
  470.         gefpointer=1
  471.         SetText "GEFUNDEN" DecToStr(gefunden)
  472.         SetBar "GEFNUMMER" VISIBLE 1 TOTAL gefunden
  473.         SetNum "GEFNUMMER" gefpointer
  474.         showfound()
  475.         BUSY
  476.       END
  477.       WHEN class = "GEFMINUS" THEN DO
  478.         gefpointer = max(gefpointer-1,1)
  479.         showfound()
  480.       END
  481.       WHEN class = "GEFPLUS" THEN DO
  482.         gefpointer = min(gefpointer+1,gefunden)
  483.         showfound()
  484.       END
  485.       WHEN class = "DRUCKEN" THEN DO
  486.         BUSY SET
  487.         IF druck=0 THEN DO
  488.           IF Open(cfile,"t:Archie.print","WRITE") THEN DO
  489.             DO k=1 TO gefunden
  490.               l=match_entry.k
  491.               text="Ausgabe  : "||Ausgabe.l||"     Jahr: "||jahr.l
  492.               CALL WriteLn(cfile,text)
  493.               text="Seite    : "||Seite.l||"    Rubrik: "||Rubrick.l
  494.               CALL WriteLn(cfile,text)
  495.               CALL WriteLn(cfile,Eintrag.l) 
  496.               CALL WriteLn(cfile,"__")
  497.             END
  498.             CALL Close(cfile)
  499.             ADDRESS COMMAND "COPY >NIL: T:ARCHIE.PRINT PRT:"
  500.             ADDRESS COMMAND "DELETE  >NIL: T:ARCHIE.PRINT"
  501.           END
  502.         END
  503.         else DO
  504.           l=match_entry.gefpointer
  505.           IF Open(cfile,"t:Archie.print","WRITE") THEN DO
  506.               text="Ausgabe  : "||Ausgabe.l||"     Jahr: "||jahr.l
  507.               CALL WriteLn(cfile,text)
  508.               text="Seite    : "||Seite.l||"    Rubrik: "||Rubrick.l
  509.               CALL WriteLn(cfile,text)
  510.               CALL WriteLn(cfile,Eintrag.l)
  511.               CALL WriteLn(cfile," ")
  512.               CALL Close(cfile)
  513.               ADDRESS COMMAND "COPY >NIL: T:ARCHIE.PRINT PRT:"
  514.               ADDRESS COMMAND "DELETE >NIL: T:ARCHIE.PRINT"
  515.           END
  516.         END
  517.         BUSY
  518.       END
  519.       WHEN class = "GEFNUMMER" THEN DO
  520.         READ "GEFNUMMER"
  521.         gefpointer = RESULT
  522.         SetBar "GEFNUMMER" VISIBLE 1 TOTAL gefunden
  523.         SetNum "GEFNUMMER" gefpointer      
  524.         ShowFound()
  525.       END
  526.       WHEN class = "SPEICHERN" THEN DO
  527.         s_file = rtfilerequest(,,"Gefundene Speichern","Speichern","rtfi_flags=freqf_patgad rtfi_matchpat=#?",nil)
  528.         if s_file~="" THEN DO
  529.           dummy=OPEN(cfile,s_file,"WRITE")
  530.           if dummy THEN DO
  531.             IF speichern=0 THEN DO
  532.               DO k=1 TO gefunden
  533.                 l=match_entry.k
  534.                 text="Ausgabe  : "||Ausgabe.l||"     Jahr: "||jahr.l
  535.                 CALL WriteLn(cfile,text)
  536.                 text="Seite    : "||Seite.l||"    Rubrik: "||Rubrick.l
  537.                 CALL WriteLn(cfile,text)
  538.                 CALL WriteLn(cfile,Eintrag.l)
  539.                 CALL WriteLn(cfile,"__")
  540.               END
  541.             END
  542.             else DO
  543.               l=match_entry.gefpointer
  544.               text="Ausgabe  : "||Ausgabe.l||"     Jahr: "||jahr.l
  545.               CALL WriteLn(cfile,text)
  546.               text="Seite    : "||Seite.l||"    Rubrik: "||Rubrick.l
  547.               CALL WriteLn(cfile,text)
  548.               CALL WriteLn(cfile,Eintrag.l)
  549.               CALL WriteLn(cfile," ")
  550.             END
  551.           END
  552.           dummy=CLOSE(cfile)
  553.         END
  554.       END
  555.       WHEN class = "AKTUELL" THEN DO
  556.         gefpointer = MAX(1,MIN(StrToDec(SUBWORD(GetArg(pkt),2)),gefunden))
  557.         showfound()
  558.       END
  559.       WHEN class = "VERGESSEN" THEN DO
  560.         IF vergessen=0 THEN gefunden=0
  561.         else DO
  562.            DO k = gefpointer+1 TO gefunden
  563.              l = k-1
  564.              match_entry.l = match_entry.k
  565.            END
  566.            gefunden = gefunden - 1
  567.            gefpointer = min(gefpointer,gefunden)
  568.         END
  569.         showfound()
  570.       END
  571.       WHEN class = "DRUCKENCYCLE" THEN druck=StrToDec(SUBWORD(GetArg(pkt),2))
  572.       WHEN class = "SPEICHERNCYCLE" THEN speichern=StrToDec(SUBWORD(GetArg(pkt),2))
  573.       WHEN class = "VERGESSENCYCLE" THEN vergessen=StrToDec(SUBWORD(GetArg(pkt),2))
  574.       OTHERWISE
  575.       END  /*Select*/
  576.     END /*IF*/
  577.   END /*DO*/
  578.  
  579.   rubriken=rubriken-1
  580.  
  581.   'hide unload'
  582.   ADDRESS VAREXX
  583.   ADDRESS VALUE OpenGUI("ArchieMain.gui") 
  584.  
  585. RETURN 0
  586.  
  587. showfound:
  588.   if gefunden>0 THEN DO
  589.     gef=match_entry.gefpointer
  590.  
  591.     SetText "GEFAUSGABE" ausgabe.gef
  592.     SetText "GEFJAHR" jahr.gef
  593.     SetText "GEFSEITE" seite.gef
  594.     SetText "GEFRUBRIK" rubrick.gef
  595.     SetText "GEFEINTRAG" eintrag.gef
  596.     SetText "GEFEINTRAGNUMMER" DecToStr(gef)
  597.     SetBar "GEFNUMMER" VISIBLE 1 TOTAL gefunden
  598.     SetNum "GEFNUMMER" gefpointer
  599.   END
  600.   else DO
  601.     SetText "GEFAUSGABE" ""
  602.     SetText "GEFJAHR" ""
  603.     SetText "GEFSEITE" ""
  604.     SetText "GEFRUBRIK" ""
  605.     SetText "GEFEINTRAG" ""
  606.     SetText "GEFEINTRAGNUMMER" ""
  607.     SetBar "GEFNUMMER" VISIBLE 1 TOTAL gefunden
  608.     SetNum "GEFNUMMER" gefpointer
  609.   END
  610.   SetText "GEFUNDEN" DecToStr(gefunden)
  611.   SetText "AKTUELL" DecToStr(gefpointer)
  612. RETURN 0
  613.  
  614. Speichern:
  615.   IF EXISTS(datei) THEN DO
  616.     IF EXISTS(datei||".BAK") THEN ADDRESS COMMAND "DELETE "||datei||".BAK"
  617.     ADDRESS COMMAND "RENAME "||datei||" "||datei||".BAK"
  618.   END
  619.   IF Open(file,datei,"WRITE") THEN DO
  620.     CALL WRITELN(file,"ARCHIE-ARCHIVDATEI")
  621.     CALL WRITELN(file,info)
  622.     CALL WRITELN(file,rubriken)
  623.     DO i=1 TO rubriken
  624.       CALL WRITELN(file,rubrik.i)
  625.     END
  626.     CALL WRITELN(file,entries)
  627.     DO i=1 TO entries
  628.       CALL WRITELN(file,ausgabe.i)
  629.       CALL WRITELN(file,jahr.i)
  630.       CALL WRITELN(file,seite.i)
  631.       CALL WRITELN(file,rubrick.i)
  632.       CALL WRITELN(file,eintrag.i)
  633.     END
  634.     CALL Close(file)
  635.   END
  636.   save=TRUE
  637. RETURN 0
  638.  
  639. /*
  640. **  PROCEDURES
  641. */
  642.  
  643. NeuAnlegen:
  644.     bodytext = "Wollen Sie ein neues Archiv anlegen?"
  645.     tagstring = "rt_reqpos=reqpos.centerwin"
  646.     dummy = rtezrequest(bodytext,"Ja|Nein","Frage:",,tagstring)
  647.     IF dummy = 1 THEN DO
  648.       IF UPPER(RIGHT(new_file,7)) ~= ".ARCHIE" THEN DO
  649.         new_file = new_file||".archie"
  650.       END
  651.  
  652.       datei = new_file
  653.       info = ""
  654.       entries = 0
  655.       rubriken = 0
  656.       rubrik.0 = ""
  657.       load = TRUE
  658.       save = FALSE
  659.       neu=FALSE
  660.       current=0
  661.  
  662.       'hide unload'
  663.       ADDRESS VAREXX
  664.       ADDRESS VALUE OpenGUI("ArchieRubriken.gui")
  665.       SET "EINGABE" DISABLE
  666.       DO FOREVER
  667.         CALL WaitPKT('MYPORT')
  668.         pkt=GetPKT('MYPORT')
  669.         IF pkt ~= '00000000'x THEN DO
  670.           class=SUBWORD(GetArg(pkt),1,1)
  671.           if ((class=CloseWindow)|class="OKAY") THEN DO
  672.              if (rubriken>0) THEN
  673.                LEAVE
  674.              else DO
  675.                bodytext = "Es muß mindestens EINE Rubrik existieren!"
  676.                tagstring = "rt_reqpos=reqpos.centerwin"
  677.                dummy = rtezrequest(bodytext,"Okay","Info:",,tagstring)
  678.              END
  679.           END
  680.           SELECT
  681.           WHEN class = "NEU" THEN DO
  682.             if neu=FALSE THEN DO
  683.              rubriken = rubriken + 1
  684.              rubrik.rubriken = "< neu >"
  685.              rubrik.count = rubriken
  686.              rubrik.select = rubriken
  687.              current=rubriken
  688.              SetList "RUBRIKEN" CLEAR STEM rubrik
  689.              SetText "EINGABE" rubrik.rubriken
  690.              Set "EINGABE" Enable
  691.              neu=TRUE
  692.             END
  693.           END
  694.           WHEN class = "RUBRIKEN" THEN DO
  695.             SetList "RUBRIKEN" SELECT=SUBWORD(GetArg(pkt),2)
  696.             SetText "EINGABE" SUBWORD(GetArg(pkt),2)
  697.             READ "RUBRIKEN" rubrik
  698.             current=rubrik.select
  699.           END
  700.           WHEN class = "EINGABE" THEN DO
  701.             rubrik.current = SUBWORD(GetArg(pkt),2)
  702.             rubrik.count = rubriken
  703.             rubrik.select = rubriken
  704.             SetList "RUBRIKEN" CLEAR STEM rubrik
  705.             IF rubrik.current~="< neu >" THEN neu=FALSE
  706.           END
  707.           WHEN class = "DEL" THEN DO
  708.             IF rubriken>0 THEN DO
  709.               DO i=current TO rubriken
  710.                 j=i+1
  711.                 rubrik.i = rubrik.j
  712.               END
  713.               rubriken=rubriken-1
  714.               current=MAX(current-1,1)
  715.               rubrik.select = current
  716.               rubrik.count = rubriken
  717.               SetList "RUBRIKEN" CLEAR STEM rubrik
  718.               SetText "Eingabe" rubrik.current
  719.             END
  720.             IF rubriken=0 THEN SET "EINGABE" DISABLE
  721.           END
  722.           WHEN class = "HOCH" THEN DO
  723.             IF Current>1 THEN DO
  724.               Current=Current-1
  725.               merk=rubrik.current
  726.               j=current+1
  727.               rubrik.current=rubrik.j
  728.               rubrik.j=merk
  729.             END
  730.             rubrik.select = current
  731.             rubrik.count = rubriken
  732.             SetList "RUBRIKEN" CLEAR STEM rubrik
  733.             SetText "Eingabe" rubrik.current
  734.           END
  735.           WHEN class = "RUNTER" THEN DO
  736.             IF Current<rubriken THEN DO
  737.               Current=Current+1
  738.               merk=rubrik.current
  739.               j=current-1
  740.               rubrik.current=rubrik.j
  741.               rubrik.j=merk
  742.             END
  743.             rubrik.select = current
  744.             rubrik.count = rubriken
  745.             SetList "RUBRIKEN" CLEAR STEM rubrik
  746.             SetText "Eingabe" rubrik.current
  747.           END
  748.           OTHERWISE
  749.           END
  750.         END
  751.       END
  752.       'hide unload'
  753.       ADDRESS VAREXX
  754.       ADDRESS VALUE OpenGUI("ArchieMain.gui")
  755.  
  756.     END
  757. RETURN 0
  758.  
  759. askforsave:
  760.   bodytext = "Das Archiv wurde noch nicht gespeichert!"
  761.   tagstring = "rt_reqpos=reqpos.centerwin"
  762.   IF rtezrequest(bodytext,"Speichern|Weiter","Warnung:",,tagstring) = 1 THEN Speichern()
  763. RETURN 0
  764.  
  765. OpenGUI:
  766.   ARG gui
  767.   guifile=pathum||'/GUI/'||gui
  768.   'load ' guifile 'MYPORT'
  769.   GUIAdr=RESULT
  770.   ADDRESS VALUE GUIAdr
  771.   show
  772. RETURN GUIAdr
  773.  
  774. LoadVarexx:
  775.     if show( 'p', 'VAREXX' ) ~= 1 then do
  776.         address command 'run ' || pathum || '/varexx/varexx'
  777.         waitforport VAREXX
  778.         launchvarexx = TRUE
  779.     end               
  780. RETURN launchvarexx
  781.  
  782. CloseVarexx:
  783.    address command pathum || "/varexx/vxc"
  784. RETURN 0
  785.  
  786. LoadLibrary:
  787.   PARSE ARG library
  788.  
  789.    IF EXISTS("libs:"||library) THEN DO
  790.     IF ~SHOW("L",library) THEN
  791.         IF ~ADDLIB(library,0,-30,0) THEN DO
  792.           SAY "Error while opening "library
  793.           EXIT
  794.         END
  795.     END
  796.     else DO
  797.       IF EXISTS(pathum||"/libs/"||library) THEN DO
  798.       IF ~SHOW("L",library) THEN
  799.          IF ~ADDLIB(pathum||"/libs/"||library,0,-30,0) THEN DO
  800.            SAY "Error while opening "library
  801.            EXIT
  802.          END
  803.       END
  804.       else DO
  805.         SAY "Error: No "library
  806.         EXIT
  807.       END
  808.     END
  809. RETURN 0  
  810.  
  811. GetPath:  PROCEDURE
  812.   PARSE ARG filename
  813.   DROP a b
  814.   a=LASTPOS("/",filename)
  815.   b=LASTPOS(":",filename)
  816.   IF a>0 THEN RETURN LEFT(filename,a)
  817.   ELSE IF b>0 THEN RETURN LEFT(filename,b)
  818. RETURN ""
  819.  
  820.  
  821. GetFile: PROCEDURE
  822.   PARSE ARG filename
  823.   DROP a b c
  824.   a=LASTPOS("/",filename)
  825.   b=LASTPOS(":",filename)
  826.   c=LENGTH(filename)
  827.   IF a>0 THEN RETURN RIGHT(filename,c-a)
  828.   ELSE IF b>0 THEN RETURN RIGHT(filename,c-b)
  829. RETURN filename
  830.  
  831.  
  832. SetMainGUI:
  833.   IF load = FALSE THEN DO
  834.     SET Info DISABLE
  835.     SET Eingeben DISABLE
  836.     SET Editieren DISABLE
  837.     SET Suchen DISABLE
  838.     SET Speichern DISABLE
  839.     SETTEXT Info ""
  840.     END
  841.   else DO
  842.     SET Info ENABLE
  843.     SET Eingeben ENABLE
  844.     IF entries > 0 THEN DO
  845.       SET Editieren ENABLE
  846.       SET Suchen ENABLE
  847.     END
  848.     else DO
  849.       SET Editieren DISABLE
  850.       SET Suchen DISABLE
  851.     END
  852.     SET Speichern ENABLE
  853.     SETTEXT "ARCHIV" datei
  854.     SETTEXT "INFO" info
  855.   END
  856.  
  857.   if (save = FALSE)&(load = TRUE) THEN SetText "STATUS" "ACHTUNG: Archiv nicht gespeichert!"
  858.   if (save = TRUE)&(load = TRUE) THEN SetText "STATUS" "Archiv gespeichert!"
  859.   if load = FALSE THEN SetText "STATUS" "Kein Archiv geladen!"
  860. RETURN 0 
  861.  
  862. StrToDec: PROCEDURE
  863.   ARG string
  864.   zahl=0
  865.   IF DATATYPE(string)="NUM" THEN zahl=String
  866. RETURN zahl  
  867.  
  868. DecToStr: PROCEDURE
  869.   ARG zahl
  870.   string=""
  871.   IF DATATYPE(zahl)="NUM" THEN String=zahl
  872. RETURN String  
  873.  
  874. SuchString: PROCEDURE
  875.   ARG string
  876.   DO UNTIL POS("**",string) = 0
  877.     IF POS("**",string) ~= 0 THEN string=DelStr(string,POS("**",string),1)
  878.   END
  879.   IF string="" THEN string="*"
  880. RETURN string
  881.  
  882. WildMatch: PROCEDURE
  883.   ARG  string,pattern
  884.  
  885.   if (pattern="*")|( pattern="") THEN
  886.     match = TRUE
  887.   else DO
  888.     match=FALSE
  889.     IF POS(pattern,string)~=0 THEN match = TRUE
  890.   END
  891. RETURN match
  892.